(load "tag-number.ss")
(load "tower.ss")

(define (same-type? type-tags)
  (let ((type (car type-tags)))
    (define (iter type-tags)
      (if (null? type-tags)
          true
          (and (eq? type (car type-tags))
               (iter (cdr type-tags)))))
    (iter (cdr type-tags))))

(define (apply-generic op . args)
  (let ((type-tags (map type-tag args)))
    (let ((proc (get op type-tags)))
      (if proc
          (apply proc (map contents args))
          (if (same-type? type-tags)
              (error "No method for these types"
                     (list op type-tags))
              (let ((top (get-top type-tags)))
                (let ((same-type-args (map 
                                      (lambda (arg) 
                                        (multi-raise top arg)) 
                                        args)))
                  (let ((proc (get op (map type-tag same-type-args))))
                    (if proc
                        (apply proc (map contents same-type-args))
                        (error "No method for these types"
                               (list op type-tags)))))))))))
